home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Commodore Disk User Volume 4 #4
/
Commodore_Disk_User_Vol.4_4_1991_-.d64
/
compact 2
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
5KB
|
163 lines
100 poke53280,l:poke53281,0
110 fort=0to4:geta$:next
120 l=l+1:ifl=1thenload"code mover",8,1
130 ifl=2thenload"load at",8,1
140 print"[147]";
141 ds=4096
142 poke53280,2:poke53281,0
150 clr
160 dimf$(109),s(20),b(20):n=10:a=0
161 print"enter data disk then press <return>"
162 geta$:ifa$<>chr$(13)then162
163 print"[159]loading directory"
164 poke882,1:poke883,0:poke884,192:poke860,asc("$"):sys820
165 goto3000
170 close1:print"[158]prog no.";a+1:input"enter name";f$(a):iff$(a)=""then220
180 input"[159]enter blocks";b(a):open1,8,0,f$(a):get#1,a$:get#1,b$
190 ifa$=""thena$=chr$(0)
200 l=asc(a$):ifb$=""thenb$=chr$(0)
210 b=asc(b$):s(a)=l+b*256:a=a+1:print"start=";s(a-1):goto170
220 gosub450
230 a=a-1:print"enter start address to run":inputb
240 poke2064,76:poke252,b-(int(b/256))*256:poke253,int(b/256)
241 print"[154]enter file name to save under":inputdm$
242 print"[159]what shall i do while decompacting?"
243 print"1....wobble screen"
244 print"2....flash screen"
245 print"3....nothing"
246 inputj
247 ifj=1thenpoke2394,22:poke2395,208:poke2400,22:poke2401,208
248 ifj=2thenpoke2394,33:poke2395,208:poke2400,33:poke2401,208
249 ifj=3thenpoke2394,0:poke2395,208:poke2400,0:poke2401,208
250 gosub570:n=10:fort=0toa:n=n+b(t):next
260 fort=ato0step-1
270 poke2067+t*3,n:poke2068+t*3,int(s(t)/256):poke2069+t*3,int(s(t)/256)+b(t)
280 n=n-b(t):next
290 poke2067+t*3,0:n=10
300 ford=0toa
310 l=len(f$(d)):poke882,l:fort=1tol:poke860+t-1,asc(mid$(f$(d),t,1)):next
320 poke883,s(d)-(int(s(d)/256)*256):poke884,n
330 print"packing ";f$(d)
340 sys820:n=n+b(d):next
350 poke251,n:n=n-b(d)
360 t=0
370 ford=ato0step-1:n=n-b(d)
371 z=0:forg=1tob(d)-1:ifn+g=int(s(d)/256)thenz=g:print"*** ***"
372 next:ifz<>0then2000
380 poke2067+t*3,n:poke2068+t*3,int(s(d)/256):poke2069+t*3,int(s(d)/256)+b(d)
390 t=t+1:next
400 poke2067+t*3,0
410 poke2064,76:poke2065,peek(252):poke2066,peek(253)
411 sys57812"@0:"+dm$,8
412 print"[147]enter disk to save ";dm$
413 print"[158]then press return"
414 input"[144]";a$
420 poke193,1:poke194,8
430 poke174,0:poke175,peek(251):sys62957
440 run140
450 print"[147]";
460 fort=0toa-1:ift+1<=9thenprint" ";
470 printt+1,f$(t),b(t);s(t):next
480 print"[159]edit any? (press number or x)"
490 inputa$:ifa$="x"thenreturn
500 ifa$=""then450
501 ifval(a$)<=0then450
510 t=val(a$):t=t-1:print"[147]";
520 print"blocks ";b(t)
530 input"blocks";b(t)
540 print"[159]start ";s(t)
550 input"start";s(t)
560 goto 460
570 print"[147]checking possible configurations ..."
571 print"";
572 fort=0toa-1:ift+1<=9thenprint" ";
573 printt+1,f$(t),b(t);s(t):next
580 cv$="[165][212][199][194][221][200][217][167]"
590 cv=1
600 ifa=0thenforcv=1to312step22:gosub620:next:return
610 zx=49152:goto670
620 ifcv>312thencv=1
630 remprint"[176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][178][178][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]"
640 print"[151]";spc(cv/8);" ";mid$(cv$,cv-(int(cv/8)*8)+1,1)
650 print"[155][173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
660 return
670 fort=0to255:pokezx+t,33:next:cv=cv+5:gosub620:ol=0
680 fort=0to7:pokezx+t,33:next:cv=cv+5:gosub620
690 fort=128to191:pokezx+t,33:next:cv=cv+5:gosub620
700 fort=191to255:pokezx+t,33:next:cv=cv+5:gosub620:no=10
710 fort=0toa:ford=0tob(t):n=int(s(t)/256)+d:cv=cv+1:no=no+1:gosub620:poke49152+n,t
720 nextd,t
730 print"[155]mapped out singular memory locations ";
740 ifno>128thenprint"[155]out of memory sorry!":print"press return to reset"
750 ifno>128theninput"[144]";a$:sys64738
760 n=10
770 fort=0toa:ford=0tob(t):n=int(s(t)/256)+d:cv=cv+1:gosub620:p=peek(49152+n)
780 ifp<>tthenprint"over lap at prog "
790 ifp<>tthenprint"over lap at prog";t;:ol=ol+1:print"with";
800 if p<>t and p<255thenprintp
810 if p<>t and p=255thenprint:print"the packed source"
820 cv=cv+.5:gosub620
830 nextd,t:sw=0
840 fort=a-1to0step-1:cv=cv+1:gosub620
850 ifs(t)<=s(t+1)then900
860 sw=1
870 n=b(t+1):b(t+1)=b(t):b(t)=n
880 n=s(t+1):s(t+1)=s(t):s(t)=n
890 n$=f$(t+1):f$(t+1)=f$(t):f$(t)=n$
900 next
910 ifsw=1thensw=0:goto840
920 n=cv:forcv=nto312step3:gosub620:print"[147]right thats that finished"
930 print"[155]all swaped and ready to go"
940 print"its the best i can do for your program"
950 print"if it does not work try spliting up somefiles or useing packer ii"
960 gosub980
970 return
980 print"";
990 fort=0toa:ift+1<=9thenprint" ";
1000 printt+1,f$(t),b(t);s(t):next
1010 return
2000 poke2067+t*3,n+z:poke2068+t*3,int(s(d)/256)+z
2010 poke2069+t*3,int(s(d)/256)+b(d):t=t+1
2011 print"********"
2040 poke2067+t*3,n:poke2068+t*3,int(s(d)/256)
2050 poke2069+t*3,int(s(d)/256)+z:goto390
3000 print"[159][147]";
3010 open1,8,0,"$"
3020 y=0:ya=49152+32:dimz(109)
3021 fort=0to109:f$(t)="quit>>>>>>>>>>>":next
3030 f$(y)="":x=0:z(y)=peek(ya)+peek(ya+1)*256:ya=ya+3:l=peek(ya):ya=ya+2
3031 ifpeek(ya)=34thenya=ya+1
3032 b=z(y)
3033 ifz(y)=0thenz(y)=1
3038 iflen(f$(y))>18theny=y-2:goto3100
3039 ifpeek(ya)=0andpeek(ya+1)=0theny=y-2:goto3100
3040 f$(y)=f$(y)+chr$(peek(ya+x)):x=x+1:ifchr$(peek(ya+x))<>chr$(34)then3038
3041 print"[147]thinking...";99-y
3050 y=y+1:ya=ya+21
3051 ify>99theny=99:goto3100
3060 ya=ya+1:ifpeek(ya)<>0then3060
3070 ifpeek(ya+1)=0theny=y-2:goto3100
3080 ya=ya+3
3082 goto3030
3083 fort=0to80:poke1024+t,peek(49152+32+t):next:fort=0toy+1:poke49152+t,0:next
3100 y=y+1:v=0:f$(y+1)=f$(101):print"[147]":dimj$(20)
3101 fort=0toy+1:poke49152+t,0:next
3110 print"[159]";:fort=0to9:ifpeek(49152+t+v)=1thenprint"";
3120 print" ";f$(t+v);"[146]";" ":next
3130 geta$:ifa$="[145]"thenv=v-1
3131 print"[151]>[155]>[155]<[151]<"
3140 ifa$=""thenv=v+1:ifv>y+1thenv=y+1
3150 ifv<0thenv=0
3151 ifa$=" "andv=y+1then3200
3160 ifa$=" "thenifpeek(49152+v)=0anda<19thenpoke49152+v,1:a=a+1:goto3110
3161 ifa$=" "thenifpeek(49152+v)=0anda>=19thenprint"no room left":goto3200
3170 ifa$=" "thenifpeek(49152+v)=1thenpoke49152+v,0:a=a-1:goto3110
3180 ifa$=""then3130
3190 goto 3110
3200 a=0:fort=0toy:ifpeek(49152+t)=1thenj$(a)=f$(t):b(a)=z(t):a=a+1
3201 next:close1
3210 fort=0toa-1:f$(t)=j$(t):open1,8,0,f$(t):get#1,a$:ifa$=""thena$=chr$(0)
3220 c=asc(a$):get#1,a$:ifa$=""thena$=chr$(0)
3230 close1:b=asc(a$):s(t)=c+b*256:next
3240 goto220